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-- file TypePack.Mesa 

-- last modified by Satterthwaite, June 30, 1978 11:34 AM 

DIRECTORY 

StringDefs: FROM "stringdef s" , 
SymbolTableDefs: FROM "symbol tabledefs" , 
SymDefs: FROM "symdefs", 
TypePackDefs: FROM "typepackdef s" ; 

TypePack: PROGRAM IMPORTS StringDefs EXPORTS TypePackDefs - 
BEGIN 
OPEN SymDefs, TypePackDefs; 

-- internal utilities 

HTHandle: TYPE - RECORD[ 
stb: SymbolTableBase, 
hti: HTIndex]; 

Equallds: PROCEDURE [idl, id2: HTHandle] RETURNS [BOOLEAN] ■ 
BEGIN 

OPEN bl: idl. stb, b2: id2.stb; 
ssl, ss2: StringDefs .SubStringDescriptor ; 
IF idl = id2 THEN RETURN [TRUE]; 

bl.SubStringForHash[6ssl, idl. hti]; b2 .SubStringForllash[@ss2 , id2.hti]; 
RETURN [StringDefs. EqualSubStrings[@ssl , @ss2]] 
END; 

CTXHandle: TYPE ■ RECORD[ 
stb: SymbolTableBase, 
ctx: CTXIndex]; 

EqContexts: PROCEDURE [contextl, context2: CTXHandle] RETURNS [BOOLEAN] = 
BEGIN 

OPEN bl: contextl. stb, b2: context2. stb ; 
ctxl, ctx2: CTXIndex; 
mdil, mdi2: MDIndex; 

IF contextl = context2 THEN RETURN [TRUE]; 
IF contextl. stb = context2.stb THEN RETURN [FALSE]; 
IF LOOPHOLE[contextl.ctx, CARDINAL] <■ 5*SIZE[simpl e CTXRecord] 

THEN RETURN [contextl . ctx « context2 . ctx] ; -- predefined types 
WITH cl: (bl.ctxb+contextl.ctx) SELECT FROM 
simple => 

BEGIN mdil «- OwnMdi; ctxl <- contextl. ctx; 
END; 
included «> 

BEGIN mdil <- cl .ctxmodule; ctxl <- cl.ctxmap; 
END; 
ENDCASE => ERROR; 
WITH c2: (b2.ctxb+context2.ctx) SELECT FROM 
simple => 

BEGIN mdi2 *- OwnMdi; ctx2 <- context2. ctx; 
END; 
included => 

BEGIN mdi2 <- c2 . ctxmodule; ctx2 <- c2.ctxmap; 
END; 
ENDCASE *> ERROR; 
RETURN [ctxl - Ctx2 
AND Equallds[ 

[contextl. stb, (bl .mdb+mdil) .mdhti] , 
[context2.stb, (b2 .mdb+mdi2) .mdhti]] 
AND 

( (bl .mdb+mdil) .mdStamp. zapped OR (b2 .mdb+mdi2) .mdStamp .zapped 
OR (bl. mdb+mdil) .mdStamp « ( b2 ,mdb+mdi2) .mdStamp)] 
END; 

-- type relations 

EquivalentTypes: PUBLIC PROCEDURE [typel, type2: TypeHandle] RETURNS [BOOLEAN] ■ 
BEGIN 

OPEN bl: typel. stb, b2: type2.stb; 
IF typel = type2 OR typel. sei = typeANY OR type2.sei * typeANY 

THEN RETURN [TRUE]; 
IF typel. sei = SENull OR type2.sei - SENull 
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THEN RETURN [typel.sei - typeZ.sei]; 
RETURN [WITH tl: (bl . seb+typel . sei ) SELECT FROM 
basic ■> 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
basic a > tl.code a t2.code, 
ENDCASE -> FALSE, 
enumerated a > 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
enumerated a > 

EqContexts[[typel.stb, tl . valuectx] , [type2.stb, t2. valuectx]], 
ENDCASE a > FALSE, 
record a > 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
record a > 

EqContexts[[typel.stb, tl .f ieldctx] , [type2.stb, t2 .f ieldctx]], 
ENDCASE a > FALSE, 
pointer a > 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
pointer a > 

(tl. ordered a t2. ordered) 
AND EquivalentTypes[ 

[typel.stb, bl.UnderType[tl.pointedtotype]], 
[type?., stb, b2 .UnderType[t2 .pointedtotype]]], 
ENDCASE => FALSE, 
array a > 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
array a > 

tl. packed = t2. packed 
AND EquivalentTypes[ 

[typel .stb, bl. Under Type[tl .component type]] , 
[type2 .stb, b2.UnderType[t2. component type]]] 
AND Equiva1entTypes[ 

[typel. stb, bl.UnderType[tl .index type]], 
[type2.stb, b2.UnderType[t2. index type]]], 
ENDCASE => FALSE, 
arraydesc a > 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
arraydesc => 

EquivalentTypes[ 

[typel.stb, bl.UnderType[tl . descr ibedType]], 
[type2.stb, b2.UnderType[t2 .describedType]]], 
ENDCASE a > FALSE, 
transfer => 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
transfer => 

tl.mode a t2.mode 
AND Equiva1entArgs[ 

[typel.stb, tl. inrecord], 
[type2.stb, t2 . inrecord]] 
AND Equiva1entArgs[ 

[typel.stb, tl.outrecord], 
[type2.stb, t2 .outrecord]] , 
ENDCASE => FALSE, 
relative => 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
relative a > 

EquivalentTypes[ 

[typel.stb, bl.UnderType[tl .baseType]], 
[type2.stb, b2 .Under Type[t2 .baseType]]] 
AND EquivalentTypes[ 

[typel.stb, bl.UnderType[tl.offsetType]], 
[type2.stb, b2. Under Type[t2 .off setType]]], 
ENDCASE => FALSE, 
subrange a > 

WITH t2: (b2.sebUype2.sei) SELECT FROM 
subrange => 

EquivalentTypes[ 

[typel. stb, bl .UnderType[tl .range type]], 
[type2.stb, b2.UnderType[t2. range type]]] 
AND 
(-tl. filled OR ~t2. filled 

OR (tl. origin a t2. origin AND tl. empty a t2. empty 
AND (tl. empty OR tl. range - t2. range))), 
ENDCASE => FALSE, 
long n > 

WITH t2: (b2.sebftype2.sei) SELECT FROM 
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long «> 

EquivalentTypes[ 

[typel.stb, bl.UnderType[tl . range type]] , 
[type2.stb, b2.L)nderType[t2 . range type]]] , 
ENDCASE => FALSE, 
real »> 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
real «> TRUE, 
ENDCASE = > FALSE, 
ENDCASE => FALSE] 
END; 

ArgHandle: TYPE = RECORD[ 
stb: SymbolTableBase, 
sei: recordCSEIndex]; 

EquivalentArgs: PROCEDURE [argl, arg2: ArgHandle] RETURNS [BOOLEAN] ■ 
BEGIN 

OPEN bl: argl. stb, b2: arg2.stb; 
seil, sei2: ISEIndex; 
checkids: BOOLEAN; 
IF argl. sei = SENull OR arg2.sei - SENull 

THEN RETURN [argl. sei - arg2.sei]; 
checkids <- ~(bl. seb+argl. sei) . unif ield AND ~(b2 . seb+arg2 . sei ) . unif ield ; 
seil <- bl . FirstCtxSe[(bl . seb+argl . sei ) .f iel dctx]; 
sei2 *~ b2. FirstCtxSe[(b2.seb+arg2. sei) .f ieldctx]; 
UNTIL seil = SENull OR sei2 = SENull 
DO 
IF ~EquivalentTypes[ 

[argl. stb, bl .UnderType[(bl .seb+seil). id type]] , 
[arg2.stb, b2 .UnderType[(b2 . seb+sei2) . idtype]]] 
OR (checkids 

AND (bl. seb+seil). htptr # HTNull 
AND (b2.seb+sei2). htptr # HTNull 
AND ~EqualIds[ 

[argl. stb, (bl . seb+seil) .htptr], 
[arg2.stb, (b2. seb+sei2) .htptr]]) 
THEN RETURN [FALSE]; 
seil «- bl.NextSe[seil]; sei2 ♦- b2 .NextSe[sei2]; 
ENDLOOP; 
RETURN [seil ■ sei2] 
END; 

AssignableTypes: PUBLIC PROCEDURE [typeL, typeR: TypeHandle] RETURNS [BOOLEAN] 
BEGIN 

OPEN bL: typeL. stb, bR: typeR. stb; 
IF typeL » typeR OR typeL. sei = typeANY OR typeR. sei - typeANY 

THEN RETURN [TRUE]; 
IF typeL. sei * SENull OR typeR. sei « SENull 

THEN RETURN [typeL. sei = typeR. sei]; 
RETURN [WITH tL: ( bL. seb+typeL. sei ) SELECT FROM 
record => 

WITH tR: (bR.seb+typeR.sei) SELECT FROM 
record => 

EqContexts[[typeL.stb, tL.f ieldctx] , [typeR. stb, tR. f ieldctx]] 
OR 
(WITH tR SELECT FROM 

linked => AssignableTypes[ 
typeL, 

[typeR. stb, bR.UnderType[l ink type]]] , 
ENDCASE => FALSE), 
ENDCASE => FALSE, 
pointer => 

WITH tR: (bR.seb+typeR.sei) SELECT FROM 
pointer => 

(~tL. ordered OR tR. ordered) 
AND AssignableTypes[ 

[typeL. stb, bL. Under Type[tL. pointed to type]], 
[typeR. stb, bR. Under Type[tR . pointed to type]]] , 
ENDCASE «> FALSE, 
arraydesc a > 

WITH tR: (bR.seb+typeR.sei) SELECT FROM 
arraydesc »> 
CommonTypes[ 
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[typeL.stb, bL.UnderType[tL. described Type]], 
[typeR.stb, bR.UnderType[ tR.describedType]]], 
ENDCASE «> FALSE, 
transfer *> 

WITH tR: (bR.seb+typeR.sei) SELECT FROM 
transfer °> 

(tL.mode ■ tR.mode OR (tL.mode ■ error AND tR.mode ■ signal)) 
AND EquivalentArgs[ 

[typeL.stb, tL. inrecord] , 
[typeR.stb, tR. inrecord]] 
AND EquivalentArgs[ 

[typeL.stb, tL.outrecord] , 
[typeR.stb, tR.outrecord]] , 
ENDCASE => FALSE, 
relative => 

WITH tR: (bR.seb+typeR.sei) SELECT FROM 
relative a > 

EquivalentTypes[ 

[typeL. stb , bL.UnderType[tL.baseType]] , 
[typeR. stb, bR. Under Type[tR. base Type]]] 
AND AssignableTypes[ 

FullR an geType[[ typeL. stb, bL.UnderType[ tL.off setType]]] , 
Full Range Type [[typeR. stb, bR. UnderType[tR. off setType]]]] , 
ENDCASE ■> FALSE, 
subrange => CoveringType[typeL, typeR], 
long => 

WITH tR: (bR.seb+typeR.sei) SELECT FROM 
long ■> 

AssignableTypes[ 

[typeL. stb, bL.UnderType[tL. range type]], 
[typeR.stb, bR.UnderType[tR .range type]]], 
ENDCASE -> FALSE, 
ENDCASE => EquivalentTypes[typeL, typeR]] 
END; 



CommonTypes: PROCEDURE [typeL, typeR: TypeHandle] RETURNS [BOOLEAN] - 
BEGIN 

OPEN bL: typeL.stb, bR: typeR.stb; 
IF typeL = typeR OR typeL. sei ■ typeANY OR typeR. sei = typeANY 

THEN RETURN [TRUE]; 
RETURN [WITH tL: ( bL . seb+typeL. sei ) SELECT FROM 
array «> 

WITH tR: (bR.seb+typeR.sei) SELECT FROM 
array => 

tL. packed = tR. packed 
AND EquivalentTypes[ 

[typeL. stb , bL.UnderType[tL . componenttype]], 
[typeR. stb, bR. Under Type[tR .componenttype]]] 
AND Cover ingType[ 

[typeL. stb, bL. Under Type[tL, index type]] , 
[typeR.stb , bR. Under Type[tR. index type]]], 
ENDCASE <=> FALSE, 
ENDCASE => EquivalentTypes[typeL, typeR]] 
END; 

CoveringType: PROCEDURE [typel, type2: TypeHandle] RETURNS [BOOLEAN] ■ 
BEGIN 

OPEN bl: typel. stb, b2: type2.stb; 
RETURN [WITH t2: ( b2 . seb+type2 . sei ) SELECT FROM 
subrange ~> 

WITFftl: (bl.seb+typel.sei) SELECT FROM 
subrange «> 

IF ~tl. filled OR -t2 . filled OR t2. empty 
OR (tl. origin = t2. origin AND tl. range >= t2. range) 
THEN CoveringType[ 

[typel. stb, bl.UnderType[tl. range type]], 
type2] 
ELSE FALSE, 
ENDCASE »> 
CoveringType[ 
typel, 

[type2.stb, b2.UnderType[t2. range type]]], 
ENDCASE -> EquivalentTypes[typel, type2]] 
END; 
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FullRangeType: PROCEDURE [type: TypeHandle] RETURNS [TypeHandle] 
BEGIN 

OPEN b: type.stb; 
sei: CSEIndex; 
sei <- type. sei; 
DO 
WITH (b.seb+sei) SELECT FROM 

subrange a > sei <- b .UnderType[rangetype]; 
ENDCASE «> EXIT; 
ENDLOOP; 
RETURN [[type.stb, sei]] 
END; 

END. 



